	use portlib
	implicit doubleprecision (a-h,o-z)
	dimension curi(25,4),curnl(9,4),curm(4),curac(4),curr(64)
	dimension r(118),bc(118,4),bf(118,4),db(118,4)
	dimension rco_i(25),n_pwri(25),rco_nl(9),n_pwrnl(9,4),n_pwrac(4)
	character el*2,ppp*5
	character string*6,n_io*2
	character today*9

	data nr,ns,ni,nnl / 118,4,25,9 /
	data rco_i /  100.41,112.41,124.41,136.41,148.41,
	&              160.41,175.41,191.41,207.41,219.82,
	&              227.82,235.82,246.41,258.41,270.41,
	&              282.41,294.41,303.82,309.82,315.82,
	&              321.82,327.82,333.82,339.82,234.82 /
	data n_pwri /  6, 7, 8, 1, 2, 9,10,11, 3, 4,
	&              12,13,14, 5,22,15,17,18,23,24,
	&              25,19,20,21,26					 /
	data rco_nl / 98.23,104.23,110.23,116.23,122.23,
	&              91.23,92.23,131.23,255.23          /
	data n_pwrnl / 47,48,48,50,50,43,44,45,46,
	&               31,32,33,34,34,27,28,29,30,
	&               35,36,37,38,49,39,40,41,42,
	&               51,52,53,54,54,55,56,57,58  /
	data curac   / 0.0d0,0.0d0,0.0d0,0.0d0 /
	data n_pwrac / 60,61,62,63 /
c	pai=3.14159265358979d0
c	r_m0=1.6605402d-27
c	e=1.60217733d-19
c	c=2.997924575d8

	open (unit=11,
	&file='n_it.dat',
	&status='old')
	read (11,fmt='(2x,i2)') n_it
	close (11)
	n_io='00'
	if (n_it.eq.0) n_io='00'
	if (n_it.eq.1) n_io='01'
	if (n_it.eq.2) n_io='02'
	if (n_it.eq.3) n_io='03'
	if (n_it.eq.4) n_io='04'
	if (n_it.eq.5) n_io='05'
	if (n_it.eq.6) n_io='06'
	if (n_it.eq.7) n_io='07'
	if (n_it.eq.8) n_io='08'
	if (n_it.eq.9) n_io='09'
	if (n_it.eq.10) n_io='10'
	if (n_it.eq.11) n_io='11'
	if (n_it.eq.12) n_io='12'
	if (n_it.eq.13) n_io='13'
	if (n_it.eq.14) n_io='14'
	if (n_it.eq.15) n_io='15'
	open (unit=11,
	&file='saiifrev00.dat',
	&status='unknown')
	read(11,fmt=
	&'(2x,a2,2x,a3,f6.1,2x,a3,f5.1,2x,a3,f7.2,a5,/,
	&2x,a4,f10.6,a3,2x,a3,f4.1,/)') 
	&el,ppp,a,ppp,z,ppp,w,ppp,
	&ppp,frad,ppp,ppp,h
	close (11)
c 	rex=3.207d0
c	w0=931.478d0
c	frev=frad*1.0d6/h
c	v=frev*(2.0d0*pai*rex)
c	beita=v/c
c	garma=1.0d0/dsqrt(1.0d0-beita**2)
c	w=w0*(garma-1.0d0)
	grid=a*sqrt(w*(w+2*931.5))/z/299.8
	open (unit=11,file='result'
	&//n_io//'.dat',status='unknown')
	do j=1,ni
	read(11,fmt='(4(3x,a5,i2,a1,i1,a2,f9.3))') 
	&(string,n_j,string,n_n,string,curi(j,n),n=1,ns)
	end do
	do j=1,nnl
	read(11,fmt='(4(3x,a6,i1,a1,i1,a2,f9.3))')
	&(string,n_j,string,n_n,string,curnl(j,n),n=1,ns)
	end do
	read(11,fmt='(4(6x,a5,i1,a2,f9.3),/)')
	&(string,n_n,string,curm(n),n=1,ns)
	do n=1,ns
	do i=1,nr
	read(11,fmt='(7x,a2,i3,a2,f9.3,3(3x,a4,i3,a1,i1,a2,f9.3))')
	&string,n_i,string,r(i),
	&string,n_i,string,n_n,string,bc(i,n),
	&string,n_i,string,n_n,string,bf(i,n),
	&string,n_i,string,n_n,string,db(i,n)
	end do
	end do
	close(11)
	b252=(bf(75,1)+bf(75,2)+bf(75,3)+bf(75,4))/4.0d0/1.0d3
	open (unit=12,
	&file='icur1_'//n_io//'.dat',status='unknown')
	write(12,fmt='(6x,a26,f6.2,a7,i3,a4,i2,a1,1x,a10)')
	&'SSC :Exciting Current for ',
	&w,' Mev/u ',int(a),'_'//el//'_',int(z),'+',' iso.field'
	write(12,fmt='(6x,a60)')
	&'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
	call date(today)
	write(12,fmt='(27x,a9,a5,/)') today,' .cal'
	write(12,fmt='(22x,a12,f8.2,a4)') 'MC CUR Icm =',curm(1),' (A)'
	write(12,fmt='(22x,a12,f7.3,a6)') 'FLD LVL B0 =',b252,' (KGs)'
	write(12,fmt='(22x,a3,f5.3)') 'BR=',grid
	write(12,fmt='(22x,a5,f9.6,a6,1x,a3,1x,i1)')
	& 'Frf =',frad,' (MHz)','H =',int(h)
	write(12,fmt='(22x,a26,/)')
	&'--------------------------'
	write(12,fmt='(10x,a1,10x,a7,10x,a6,10x,a9)')
	& 'i','Rco(cm)','PWR_no','IC_CUR(A)'
	write(12,fmt='(9x,a55)')
	&'-------------------------------------------------------'
	do i=1,ni
	write(12,fmt='(9x,i2,9x,f7.2,13x,i2,13x,f7.2)')
	& i,rco_i(i),n_pwri(i),curi(i,1)
	end do
	write(12,fmt='(9x,a55,/)')
	&'-------------------------------------------------------'
	write(12,fmt='(5x,a1,1x,a7,4(2x,a11))')
	& 'i','Rco(cm)',
	&'PWR CUR1(A)','PWR CUR2(A)','PWR CUR3(A)','PWR CUR4(A)'
	write(12,fmt='(1x,a13,4(2x,a11))')
	& 'NLC:---------',
	&'-----------','-----------','-----------','-----------'
	do i=1,nnl
	write(12,fmt='(5x,i1,1x,f7.2,4(3x,i2,1x,f7.2))')
	& i,rco_nl(i),(n_pwrnl(i,n),curnl(i,n),n=1,ns)
	end do
	write(12,fmt='(2x,a64)')
	&'AC:-------------------------------------------------------------'
	write(12,fmt='(14x,4(3x,i2,1x,f7.2))')
	&(n_pwrac(n),curac(n),n=1,ns)
	write(12,fmt='(5x,a61)')
	&'-------------------------------------------------------------'
	write(12,fmt='(5x,a34)') 'LIMITED VALUES OF THE COIL CURT. :'
	write(12,fmt='(20x,a17)') '(Imc)max=4000 (A)'
	write(12,fmt='(20x,a17)') '(Iac)max= 105 (A)'
	write(12,fmt='(20x,a17)') '(Itc)max= 240 (A)'
	close(12)
	do i=1,ni
	curr(n_pwri(i))=curi(i,1)
	end do
	do n=1,ns
	do i=1,nnl
	curr(n_pwrnl(i,n))=curnl(i,n)
	end do
	end do
	do n=1,ns
	curr(n_pwrac(n))=curac(n)
	end do
	open (unit=12,
	&file='icur2_'//n_io//'.dat',status='unknown')
	write(12,fmt='(6x,a26,f6.2,a7,i3,a4,i2,a1,1x,a10)')
	&'SSC :Exciting Current for ',
	&w,' Mev/u ',int(a),'_'//el//'_',int(z),'+',' iso.field'
	write(12,fmt='(6x,a60)')
	&'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
	call date(today)
	write(12,fmt='(27x,a9,a5,/)') today,' .cal'
	write(12,fmt='(22x,a12,f8.2,a4)') 'MC CUR Icm =',curm(1),' (A)'
	write(12,fmt='(22x,a12,f7.3,a6)') 'FLD LVL B0 =',b252,' (KGs)'
	write(12,fmt='(22x,a25,/)')
	&'-------------------------'
	write(12,fmt='(2x,4(3x,a13))')
	& 'Power  TC-CUR','Power  TC-CUR','Power  TC-CUR','Power  TC-CUR'
	write(12,fmt='(4(6x,a10))')
	& 'No.    (A)','No.    (A)','No.    (A)','No.    (A)'
	write(12,fmt='(2x,4(3x,a13))')
	& '-------------','-------------','-------------','-------------'
	do i=1,16
	write(12,fmt='(1x,4(5x,i2,2x,f7.2))')
	& ((j-1)*16+i,curr((j-1)*16+i),j=1,4)
	end do
	write(12,fmt='(5x,a61)')
	& '-------------------------------------------------------------'
	close(12)
	n_it=n_it+1
	open (unit=13,
	&file='n_it.dat',
	&status='old')
	write (13,fmt='(2x,i2)') n_it
	close (13)
	stop
	end

